home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
DELPHI32
/
EDIT_UTL
/
DBRICH
/
DBRICH.PAS
next >
Wrap
Pascal/Delphi Source File
|
1996-03-31
|
9KB
|
332 lines
unit dbrich;
{Writen by
Sean Cross
Sean@CRM.co.nz
c/o 11 Albert St
Waipukurau
New Zealand
Borland TDBMemo code modified to use RichEdit component instead.
Note Slight bug, call Tablex.Edit before modifying paragraph properties}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, DB, DBTables, Menus, ExtCtrls, Mask, Buttons, DBCtrls;
type
TDBRichEdit = class(TRichEdit)
private
FDataLink: TFieldDataLink;
FAutoDisplay: Boolean;
FFocused: Boolean;
FMemoLoaded: Boolean;
FPaintControl: TPaintControl;
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetReadOnly: Boolean;
procedure SetDataField(const Value: string);
procedure SetDataSource(Value: TDataSource);
procedure SetReadOnly(Value: Boolean);
procedure SetAutoDisplay(Value: Boolean);
procedure SetFocused(Value: Boolean);
procedure UpdateData(Sender: TObject);
procedure WMCut(var Message: TMessage); message WM_CUT;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
protected
procedure Change; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure WndProc(var Message: TMessage); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure LoadMemo;
property Field: TField read GetField;
published
property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Data Controls', [TDBRichEdit]);
end;
{Mostly copied from DBMemo}
constructor TDBRichEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
inherited ReadOnly := True;
FAutoDisplay := True;
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnEditingChange := EditingChange;
FDataLink.OnUpdateData := UpdateData;
FPaintControl := TPaintControl.Create(Self, 'EDIT');
end;
destructor TDBRichEdit.Destroy;
begin
FPaintControl.Free;
FDataLink.Free;
FDataLink := nil;
inherited Destroy;
end;
procedure TDBRichEdit.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
procedure TDBRichEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key, Shift);
if FMemoLoaded then
begin
if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
FDataLink.Edit;
end else
Key := 0;
end;
procedure TDBRichEdit.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
if FMemoLoaded then
begin
if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
not FDataLink.Field.IsValidChar(Key) then
begin
MessageBeep(0);
Key := #0;
end;
case Key of
^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
FDataLink.Edit;
#27:
FDataLink.Reset;
end;
end else
begin
if Key = #13 then LoadMemo;
Key := #0;
end;
end;
procedure TDBRichEdit.Change;
begin
with FdataLink do
begin
{if Assigned(FdataLink) and (Assigned(DataSource))and (DataSource.State = dsBrowse) then
Edit; } {make sure edits on Attributes change}
if FMemoLoaded then Modified;
end;
FMemoLoaded := True;
inherited Change;
end;
function TDBRichEdit.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TDBRichEdit.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value;
if Value <> nil then Value.FreeNotification(Self);
end;
function TDBRichEdit.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
procedure TDBRichEdit.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
function TDBRichEdit.GetReadOnly: Boolean;
begin
Result := FDataLink.ReadOnly;
end;
procedure TDBRichEdit.SetReadOnly(Value: Boolean);
begin
FDataLink.ReadOnly := Value;
end;
function TDBRichEdit.GetField: TField;
begin
Result := FDataLink.Field;
end;
procedure TDBRichEdit.LoadMemo;
var BS: tBlobStream;
begin
if not FMemoLoaded and (FDataLink.Field is TBlobField) then
begin
try
BS := tBlobStream.Create(TBlobField(FDataLink.Field), bmRead);
Lines.LoadFromStream(BS);
BS.Free;
{Lines.Text := FDataLink.Field.AsString;}
FMemoLoaded := True;
except
Lines.Text := 'Error in TDBRichEdit.LoadMemo. Memo too large?';
end;
EditingChange(Self);
end;
end;
procedure TDBRichEdit.DataChange(Sender: TObject);
begin
if FDataLink.Field <> nil then
if FDataLink.Field is TBlobField then
begin
if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
begin
FMemoLoaded := False;
LoadMemo;
end else
begin
Lines.Text := '(' + FDataLink.Field.DisplayLabel + ')';
FMemoLoaded := False;
end;
end else
begin
if FFocused and FDataLink.CanModify then
Lines.Text := FDataLink.Field.Text
else
Lines.Text := FDataLink.Field.DisplayText;
FMemoLoaded := True;
end
else
begin
if csDesigning in ComponentState then Text := Name else Text := '';
FMemoLoaded := False;
end;
end;
procedure TDBRichEdit.EditingChange(Sender: TObject);
begin
inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
end;
procedure TDBRichEdit.UpdateData(Sender: TObject);
var BS : tBlobStream;
begin
{FDataLink.Field.AsString := Lines.Text;}
BS := tBlobStream.Create(TBlobField(FDataLink.Field), bmWrite);
Lines.SaveToStream(BS);
BS.Free;
end;
procedure TDBRichEdit.SetFocused(Value: Boolean);
begin
if FFocused <> Value then
begin
FFocused := Value;
if not (FDataLink.Field is TBlobField) then FDataLink.Reset;
end;
end;
procedure TDBRichEdit.WndProc(var Message: TMessage);
begin
with Message do
if (Msg = WM_CREATE) or (Msg = WM_WINDOWPOSCHANGED) or
(Msg = CM_FONTCHANGED) then FPaintControl.DestroyHandle;
inherited;
end;
procedure TDBRichEdit.CMEnter(var Message: TCMEnter);
begin
SetFocused(True);
inherited;
end;
procedure TDBRichEdit.CMExit(var Message: TCMExit);
begin
if FDataLink.Field is TBlobField then
try
FDataLink.UpdateRecord;
except
SetFocus;
raise;
end;
SetFocused(False);
inherited;
end;
procedure TDBRichEdit.SetAutoDisplay(Value: Boolean);
begin
if FAutoDisplay <> Value then
begin
FAutoDisplay := Value;
if Value then LoadMemo;
end;
end;
procedure TDBRichEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
if not FMemoLoaded then LoadMemo else inherited;
end;
procedure TDBRichEdit.WMCut(var Message: TMessage);
begin
FDataLink.Edit;
inherited;
end;
procedure TDBRichEdit.WMPaste(var Message: TMessage);
begin
FDataLink.Edit;
inherited;
end;
procedure TDBRichEdit.CMGetDataLink(var Message: TMessage);
begin
Message.Result := Integer(FDataLink);
end;
procedure TDBRichEdit.WMPaint(var Message: TWMPaint);
var
S: string;
begin
if not (csPaintCopy in ControlState) then inherited else
begin
if FDataLink.Field <> nil then
if FDataLink.Field is TBlobField then
S := AdjustLineBreaks(FDataLink.Field.AsString) else
S := FDataLink.Field.DisplayText;
SendMessage(FPaintControl.Handle, WM_SETTEXT, 0, Integer(PChar(S)));
SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
end;
end;
end.